home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / dir_bas.exe / DIR.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-08-26  |  13.4 KB  |  326 lines
  1. '       *** DIR.BAS ***
  2. '
  3. '       Fairchild Computer Services
  4. '       Route 5, Box 523-12
  5. '       Wills Point, TX   75169
  6. '       (903) 873-2114
  7. '
  8. '**************************** GENERAL NOTATIONS ***************************
  9. ' I wrote this program for several reasons:
  10. '   1) To serve as a good example of how to use QuickBASIC's INTERRUPT and
  11. '      INTERRUPTX subroutines.
  12. '   2) QuickBasic doesn't have any good 'directory-getting' functions.
  13. '      ('FILES' just doesn't cut it!).
  14. '   3) To solicit comments on my coding, and use of interrupts.
  15. '   4) Return a SMALL bit for all I've learned from the Shareware community.
  16. '   5) Let people know I exist for possible business/idea networking.
  17. '                               Enjoy!!                                -jmf
  18. '**************************************************************************
  19.  
  20. '************************** COMMAND LINE CREATION *************************
  21. ' To make a quicklibrary:         |    | To make a makefile, create a file
  22. ' BC   DIR/O/T/C:512;             |    | named: YOURFILE.MAK (where YOURFILE
  23. ' LINK DIR/EX/NOE/NOD:BRUN45.LIB  |    | is the file you wish to use). In it:
  24. '      DIR                        | or |
  25. '      NUL                        |    |     YOURFILE.BAS
  26. '      BCOM45.LIB+                |    |     DIR.BAS
  27. '      QB.LIB                     |    |
  28. '**************************************************************************
  29.  
  30. '************************** FUNCTION DECLARATIONS *************************
  31. '**************************************************************************
  32.  
  33. '************************* SUBROUTINE DECLARATIONS ************************
  34. '**************************************************************************
  35.  
  36. '******************* CONSTANT/INCLUDE FILE DECLARATIONS *******************
  37.  
  38.   ' $INCLUDE: 'DIR.INC'                 'Use this for DIR.BAS declares, etc.
  39.   ' $INCLUDE: 'QB.BI'                   'Use this for interrupt calls
  40.  
  41. '**************************************************************************
  42.  
  43. '************************ DATABASE (TYPE) LAYOUTS *************************
  44. '**************************************************************************
  45.  
  46. '**************** DECLARE GLOBAL (COMMON) SHARED VARIABLES ****************
  47. '**************************************************************************
  48.  
  49. '********************* DECLARE LOCAL SHARED VARIABLES *********************
  50.  
  51.   DIM SHARED DTAOff%                    'Holds DTA segment offset address
  52.  
  53. '**************************************************************************
  54.  
  55. '**************************** CREATE VARIABLES ****************************
  56. '**************************************************************************
  57.  
  58. '*************************** DATA DECLARATIONS ****************************
  59. '**************************************************************************
  60.  
  61. '************************* MAIN SUBROUTINE CALLS **************************
  62. '**************************************************************************
  63.  
  64. '*************************** DATA DECLARATIONS ****************************
  65. '**************************************************************************
  66.  
  67. '***************************** EXIT ROUTINES ******************************
  68. '**************************************************************************
  69.  
  70. FUNCTION ConvertDate$ (DateIn&)
  71.  
  72.   DirMon$ = MaskIt$(LTRIM$(STR$(INT(DateIn& / 32) AND 15)), 2, "Z")
  73.   DirDay$ = MaskIt$(LTRIM$(STR$(DateIn& AND 31)), 2, "Z")
  74.   DirYr$ = MaskIt$(LTRIM$(STR$(INT(DateIn& / 512) + 1980)), 2, "Z")
  75.  
  76.   ConvertDate$ = DirMon$ + "/" + DirDay$ + "/" + DirYr$
  77.  
  78. END FUNCTION
  79.  
  80. FUNCTION ConvertSize$ (SizeIn&)
  81.  
  82.   ConvertSize$ = MaskIt$(LTRIM$(STR$(SizeIn&)), 9, "R")
  83.  
  84. END FUNCTION
  85.  
  86. FUNCTION ConvertTime$ (TimeIn&)
  87.  
  88.   DirHour% = INT(TimeIn& / 2048)
  89.   SELECT CASE DirHour%
  90.     CASE 0
  91.       DirHour% = 12
  92.       AmPm$ = "a"
  93.     CASE IS < 12
  94.       AmPm$ = "a"
  95.     CASE 12
  96.       AmPm$ = "p"
  97.     CASE ELSE
  98.       DirHour% = DirHour% - 12
  99.       AmPm$ = "p"
  100.   END SELECT
  101.   DirHour$ = MaskIt$(LTRIM$(STR$(DirHour%)), 2, "Z")
  102.   DirMins$ = MaskIt$(LTRIM$(STR$(INT(TimeIn& / 32) AND 63)), 2, "Z")
  103.  
  104.   ConvertTime$ = DirHour$ + ":" + DirMins$ + AmPm$
  105.  
  106. END FUNCTION
  107.  
  108. FUNCTION CurrentDevice$
  109.  
  110.   InRegs.AX = &H1900                    'AH=19 (function) [gets default drive]
  111.   CALL INTERRUPT(&H21, InRegs, OutRegs) 'Interrupt 21
  112.   DefaultDrive% = OutRegs.AX AND 255    '0=A, 1=B, etc.
  113.  
  114.   CurrentDevice$ = MID$(alphabet$, DefaultDrive% + 1, 1) + ":"
  115.  
  116. END FUNCTION
  117.  
  118. FUNCTION CurrentDir$
  119.  
  120.   ' This function will use the Dir$ function to determine the current
  121.   ' DEVICE:\DIRECTORY on the default device.
  122.  
  123.   t$ = null$                            'Initialize temp variable
  124.   DirPath$ = SPACE$(255)                'Set up buffer area
  125.   InRegsX.AX = &H4700                   'AH=47 (function) [gets current path]
  126.   InRegsX.DX = Lit0%                    'Input device designation
  127.   InRegsX.DS = VARSEG(DirPath$)         'Buffer segment address
  128.   InRegsX.SI = SADD(DirPath$)           'Buffer offset address
  129.   CALL INTERRUPTX(&H21, InRegsX, OutRegsX) 'Interrupt 21
  130.   ErrorFlag% = OutRegsX.FLAGS AND 1     '0=good, 1=bad code
  131.   ErrorCode% = OutRegsX.AX              'AX contains error when FLAGS and 1=1
  132.   IF ErrorFlag% THEN                    'We got an error?
  133.     t$ = DirError$(ErrorCode%)          ' yep, return as Dir$ call string
  134.     GOTO ExitCurrentDir                 ' and get outta here
  135.   END IF
  136.  
  137.   DirPath$ = LEFT$(DirPath$, INSTR(DirPath$, CHR$(0)) - 1)
  138.   t$ = CurrentDevice$ + "\" + DirPath$
  139.  
  140. GOTO ExitCurrentDir
  141.  
  142. ExitCurrentDir:
  143.   CurrentDir$ = t$                      'Return correct DEVICE:\DIRECTORY val
  144. END FUNCTION
  145.  
  146. FUNCTION Dir$ (file$)
  147.  
  148.   ' This function is called using: variable$ = Dir$(filespec$)
  149.   ' The first filename matching filespec$ will be returned. Subsequent
  150.   ' calls should pass a null (ex: variable$ = Dir$("")) string for more
  151.   ' filenames matching original filespec call. When no more matches are
  152.   ' found, null is returned. To reset, use a new filespec$.
  153.   ' -  The following is the breakdown of the output from Dir$():
  154.   '    DirRecord.EntryName      (STRING * 12)
  155.   '    DirRecord.EntrySize      (LONG - can be converted using DirConvert)
  156.   '    DirRecord.EntryDate      (LONG - can be converted using DirConvert)
  157.   '    DirRecord.EntryTime      (LONG - can be converted using DirConvert)
  158.   '    DirRecord.ReadOnlyFlag   (INTEGER - True/False)
  159.   '    DirRecord.HiddenFlag     (INTEGER - True/False)
  160.   '    DirRecord.SystemFlag     (INTEGER - True/False)
  161.   '    DirRecord.ArchiveFlag    (INTEGER - True/False)
  162.   '    DirRecord.DirectoryFlag  (INTEGER - True/False)
  163.  
  164.   InRegsX.AX = &H2F00                   'AH=2F (function) [gets DTA address]
  165.   CALL INTERRUPTX(&H21, InRegsX, OutRegsX) 'Interrupt 21
  166.   DTASeg% = OutRegsX.ES                 'Gets DTA segment address
  167.   DTAOff% = OutRegsX.BX                 'DTA offset address
  168.   IF file$ <> "" THEN                   'Check if first lookup
  169.     file$ = file$ + CHR$(0)             'file$ needs a terminator
  170.     InRegsX.AX = &H4E00                 'AH=4E (function) [get 1st dir entry]
  171.     InRegsX.CX = &HFFFF                 'Set for all attributes
  172.     InRegsX.DS = VARSEG(file$)          'Segment address of filename
  173.     InRegsX.DX = SADD(file$)            'Filename offset
  174.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX) 'Interrupt 21
  175.     DirRecord.ErrorFlag = OutRegsX.FLAGS AND 1 '0=good, 1=bad code
  176.     ErrorCode% = OutRegsX.AX            'AX contains error when FLAGS and 1=1
  177.     IF DirRecord.ErrorFlag THEN         'We got an error?
  178.       t$ = DirError$(ErrorCode%)        ' yep, return as Dir$ call string
  179.       GOTO ExitDir                      ' and get outta here
  180.     END IF
  181.   ELSE                                  'Must be subsequent lookup...
  182.     InRegsX.AX = &H4F00                 'AH=4F (function) [get next dir entry]
  183.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX) 'Interrupt 21
  184.     DirRecord.ErrorFlag = OutRegsX.FLAGS AND 1 '0=good, 1=bad code
  185.     ErrorCode% = OutRegsX.AX            'AX contains error when FLAGS and 1=1
  186.     IF DirRecord.ErrorFlag THEN         'We got an error?
  187.       t$ = DirError$(ErrorCode%)        ' yep, return as Dir$ call string
  188.       GOTO ExitDir                      ' and get outta here
  189.     END IF
  190.   END IF
  191.   DEF SEG = DTASeg%                     'Use DTA segment address
  192.   c% = 30                               'Init filename bit counter
  193.   t$ = ""                               'Init tempname holder
  194.   DO                                    'Start loop
  195.     t$ = t$ + CHR$(DTABit%(c%))         'Get next bit & add
  196.     c% = c% + 1                         'Increment bit counter
  197.   LOOP UNTIL DTABit%(c%) = 0            'Keep goin til we hit end ASCII '0'
  198.   ' Can't mask following in case dir name is integer value (won't sort!)
  199.   DirRecord.EntryName = LEFT$(t$ + SPACE$(12), 12)
  200.   DirRecord.EntryTime = DTABit%(22) + DTABit%(23) * 256&
  201.   DirRecord.EntryDate = DTABit%(24) + DTABit%(25) * 256&
  202.   DirRecord.EntrySize = DTABit%(26) + DTABit%(27) * 256& + DTABit%(28) * 65536
  203.   Attr% = DTABit%(21)                   'Interpret attribute bit
  204.   DirRecord.ReadOnlyFlag = Attr% AND 1  'File read-only bit set? (T/F)
  205.   DirRecord.HiddenFlag = Attr% AND 2    'File hidden bit set? (T/F)
  206.   DirRecord.SystemFlag = Attr% AND 4    'File system bit set? (T/F)
  207.   DirRecord.ArchiveFlag = Attr% AND 8   'File archive bit set? (T/F)
  208.   DirRecord.DirectoryFlag = Attr% AND 16'File directory bit set? (T/F)
  209.   DEF SEG                               'Back to BASIC segment
  210.  
  211. GOTO ExitDir
  212.  
  213. ExitDir:
  214.   Dir$ = t$
  215. END FUNCTION
  216.  
  217. FUNCTION DirCount% (file$)
  218.  
  219.   ' This function will return the number of valid directory entries
  220.   ' matching file$.
  221.  
  222.   c% = 0                                'Initialize counter
  223.   t$ = Dir$(file$)                      'Do first call for match
  224.   IF t$ <> null$ THEN                   'Find one??
  225.     DO                                  'Yes, begin search loop
  226.       c% = c% + 1                       'Increment counter
  227.       t$ = Dir$(null$)                  'Get next match
  228.     LOOP UNTIL t$ = null$               ' until no more matches found
  229.   END IF
  230.  
  231.   DirCount% = c%                        'Return directory entry count
  232.  
  233. END FUNCTION
  234.  
  235. FUNCTION DirError$ (Code%)
  236.  
  237.   SELECT CASE Code%                     'Check AX register for error
  238.     CASE 3                              '3 means path not found
  239.       t$ = "Wrong Path  "               'tell em
  240.       DirRecord.ErrorDesc = t$          ' and error description
  241.     CASE 15                             '15 means bad device (not found)
  242.       t$ = "No Device   "               'tell em
  243.       DirRecord.ErrorDesc = t$          ' and error description
  244.     CASE 18                             '18 means no more files found
  245.       t$ = ""                           'tell em
  246.       DirRecord.ErrorDesc = "NoMoreFound " ' and error description
  247.     CASE ELSE                           'Don't know any others
  248.       t$ = "UnknownError"               ' so, let em know
  249.       DirRecord.ErrorDesc = t$          ' and error description
  250.   END SELECT
  251.   DirRecord.EntryName = t$              'Pass back entry name as error
  252.  
  253.   DirError$ = t$                        ' ...and finally, return the call val
  254.  
  255. END FUNCTION
  256.  
  257. FUNCTION DTABit% (BitNumber%)
  258.  
  259.   DTABit% = PEEK(DTAOff% + BitNumber%)
  260.  
  261. END FUNCTION
  262.  
  263. FUNCTION MaskIt$ (text$, length%, edits$)
  264.  
  265.   ' MaskIt$ is a simple function that will edit (mask) an input string. It
  266.   ' can be used to add leading zeroes, justify text or numbers, etc. If you
  267.   ' wish to edit numeric type data, you will need to convert it into text$
  268.   ' before using this function (use STR$).
  269.   '
  270.   ' edits$ includes a combination of the following:
  271.   ' C = Compress (extract all spaces)
  272.   ' L = Left justify
  273.   ' R = Right justify
  274.   ' T = Trim leading and trailing spaces
  275.   ' Z = Add leading zeros
  276.   ' , = Add commas to numeric string
  277.  
  278.   edits$ = UCASE$(edits$)
  279.   blank$ = SPACE$(1)
  280.   comma$ = ","
  281.   numeric$ = "0123456789"
  282.   slash$ = "/"
  283.   IF INSTR(edits$, "T") THEN text$ = LTRIM$(RTRIM$(text$))
  284.   l% = LEN(text$)
  285.   IF INSTR(edits$, "C") OR INSTR(edits$, ",") THEN
  286.     c$ = ""
  287.     c% = 1
  288.     DO
  289.       IF MID$(text$, c%, 1) <> blank$ THEN c$ = c$ + MID$(text$, c%, 1)
  290.       c% = c% + 1
  291.     LOOP UNTIL c% > l%
  292.     text$ = c$
  293.   END IF
  294.   IF INSTR(edits$, "L") THEN
  295.     text$ = LEFT$(text$ + SPACE$(length%), length%)
  296.   ELSE
  297.     IF INSTR(edits$, "R") THEN
  298.       text$ = RIGHT$(SPACE$(length%) + text$, length%)
  299.     END IF
  300.   END IF
  301.   IF INSTR(edits$, "Z") THEN text$ = RIGHT$(STRING$(length%, 48) + text$, length%)
  302.   IF INSTR(edits$, ",") THEN
  303.     SELECT CASE LEN(text$)              'Evaluate string length
  304.       CASE IS < 4                       '3 or less?
  305.       CASE ELSE                         'Otherwise...
  306.         t$ = text$                      'Save text$ to temp work variable
  307.         c$ = ""                         'Initialize temp string variable
  308.         DO                              'Begin loop
  309.           lt% = LEN(t$)                 'Save string length to temp variable
  310.           c$ = c$ + LEFT$(t$, 1)        'Add another digit
  311.           t$ = RIGHT$(t$, lt% - 1)      'Elim digit from string
  312.           IF lt% MOD 3 = 1 THEN         'Divisible by 3?
  313.             IF lt% > 1 THEN c$ = c$ + "," 'Yes, add comma
  314.           END IF                        'End division check
  315.         LOOP WHILE lt% > 1              'End loop if last digit
  316.     END SELECT
  317.     text$ = c$
  318.   END IF
  319.  
  320. ExitMaskIt:
  321.  
  322.   MaskIt$ = text$
  323.  
  324. END FUNCTION
  325.  
  326.